home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 11
/
Cream of the Crop 11-1.iso
/
comm
/
tcp4w15.zip
/
PWLPQ.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-06-08
|
5KB
|
206 lines
Program PWTN;
{$A+,B-,D+,F-,G+,I-,K+,L+,N-,P+,Q+,R+,S+,T+,V+,W+,X+,Y+}
{$M 8192,8192}
{Simple LPQ (Line Printer Queue) Client for TCP4W}
{See RFC 1179 for LPQ-Definitions}
Uses WinTypes, WinProcs, WinCrt, Strings, UseTcp4w;
Const TIL = 255;
Type PTextItem = ^TTextItem;
TTextItem = Array [0..TIL] of Char;
Var Status: Integer;
S: TSocket;
Port: Integer;
H: String;
PrinterIP: Array [0..80] Of Char;
T: TTextItem;
IP: TIP;
F: File;
SaveExitProc: Pointer;
Procedure WriteWinsockVerInfo;
Const WSADESCRIPTION_LEN = 256;
WSASYS_STATUS_LEN = 128;
Type TWSAData = Record
wVersion: Word;
wHighVersion: Word;
szDescription: Array [0..WSADESCRIPTION_LEN] Of Char;
szSystemStatus: Array [0..WSASYS_STATUS_LEN] Of Char;
iMaxSockets: Byte;
iMaxUdpDg: Byte;
lpVendorInfo: Pointer;
End;
TWSAStartUp = Function (wVersionRequested: Word; WSAData: TWSAData): Integer;
TWSACleanup = Function: Integer;
Var WSAData: TWSAData;
hWinsock: THandle;
FP : TFarProc;
Begin
hWinsock := LoadLibrary ('WINSOCK');
If hWinsock >= 32 Then
Begin
FP := GetProcAddress (hWinsock, 'WSAStartup');
If FP <> NIL Then
If TWSAStartUp (FP) (257, WSAData) = 0 Then
WriteLn (WSAData.szDescription);
FP := GetProcAddress (hWinsock, 'WSACleanup');
If FP <> NIL Then TWSACleanUp (FP);
FreeLibrary (hWinsock)
End
End;
Procedure CheckIO;
Begin
If IOResult = 0 Then Exit;
WriteLn;
WriteLn ('File-Error.');
Halt
End;
Procedure CheckStatus;
Begin
If Status > 0 Then Exit;
WriteLn;
WriteLn ('?', Tcp4W_Error (Status));
Halt
End;
Procedure PrinterAnswer;
Var I: Word;
Begin
Status := TcpRecv (S, T, TIL, 10, -1);
If Status > 0 Then T[Status] := #0;
If (Status = IP_EmptyBuffer) Then Exit;
CheckStatus;
If StrLen (T) > 0 Then
Begin
WriteLn;
WriteLn ('Printer-Error.');
Halt
End;
End;
Procedure TypeFile;
Var L: LongInt;
Begin
L := FileSize (F);
While L > TIL Do
Begin
BlockRead (F, T, TIL);
CheckIO;
Status := TCPSend (S, T, TIL, False, -1);
CheckStatus;
L := L - TIL;
Write ('.');
End;
If L = 0 Then Exit;
BlockRead (F, T, L);
CheckIO;
Status := TCPSend (S, T, L, False, -1);
CheckStatus
End;
Procedure MyExitProc; Far;
Begin
ExitProc := SaveExitProc;
If S <> 0 Then TcpClose (S);
Tcp4wCleanUp;
End;
Begin
CmdShow := sw_ShowMaximized;
AutoTracking := False;
WriteLn ('Simple lpq Client by AStA (Andreas.Tikart@uni-konstanz.de) <Polarwolf>');
S := 0;
Port := 515;
Status := Tcp4wInit;
CheckStatus;
SaveExitProc := ExitProc;
ExitProc := @MyExitProc;
Tcp4wVer (T, TIL);
WriteLn (T);
WriteWinsockVerInfo;
WriteLn;
Write ('Printer-IP:');
ReadLn (PrinterIP);
If StrLen (PrinterIP) = 0 Then Halt;
Status := TcpConnect (S, PrinterIP, '', Port);
CheckStatus;
WriteLn ('Socket: ', S, ' Port: ', Port);
Status := TcpGetRemoteID (S, T, TIL, IP);
CheckStatus;
WriteLn ('Remote Printer: ', T, ' (', IP.B1, '.', IP.B2, '.',
IP.B3, '.', IP.B4, ')');
StrPCopy (T, #2'AStA'#10);
Status := TCPSend (S, T, StrLen (T), False, -1);
CheckStatus;
PrinterAnswer;
StrPCopy (T, #2'2 cfA004'#10);
Status := TCPSend (S, T, StrLen (T), False, -1);
CheckStatus;
PrinterAnswer;
StrPCopy (T, 'o'#10#0);
Status := TCPSend (S, T, StrLen (T)+1, False, -1);
CheckStatus;
PrinterAnswer;
TcpClose (S);
S := 0;
CheckStatus;
Status := TcpConnect (S, PrinterIP, '', Port);
CheckStatus;
StrPCopy (T, #2'AStA'#10);
Status := TCPSend (S, T, StrLen (T), False, -1);
PrinterAnswer;
WriteLn;
Write ('Postscipt-Filename:');
ReadLn (H);
If Length (H) = 0 Then Halt;
Assign (F, H);
Reset (F, 1);
CheckIO;
Str (FileSize (F), H);
CheckIO;
If H [1] = ' ' Then H := Copy (H, 2, 255);
StrPCopy (T, #3+H+' dfA004'#10);
Status := TCPSend (S, T, StrLen (T), False, -1);
CheckStatus;
TypeFile;
StrPCopy (T, #0);
Status := TCPSend (S, T, 1, False, -1);
CheckStatus;
PrinterAnswer;
Close (F);
CheckIO;
TcpClose (S);
S := 0;
CheckStatus;
Status := TcpConnect (S, PrinterIP, '', Port);
CheckStatus;
StrPCopy (T, #1'AStA'#10#0);
Status := TCPSend (S, T, StrLen (T)+1, False, -1);
PrinterAnswer;
TcpClose (S);
S := 0;
CheckStatus;
WriteLn;
WriteLn ('OK');
End.